Chip: 2001 Haziran/CHIP Haziran2001.iso/prog/haziran/19/setup.exe/data.z/speaker_lib.pas

Pascal/Delphi Source File | 2001-04-11 | 5KB | 195 lines

{////////////////////////////////////////////////////////////////
// File - speaker_lib.pas
//
// This application plays a tone to the speaker, and is
// controlled via a graphical user interface - speaker_gui
// The speaker is accessed directly on the motherboard, using
// WinDriver functions.
//
// this file contain the access functions to the speaker
// using WinDriver.
////////////////////////////////////////////////////////////////}


unit Speaker_Lib;

interface

uses
  Windows, windrvr, bits;

const
 SPEAKER_IO_42 = 0;
 SPEAKER_IO_43 = 1;
 SPEAKER_IO_61 = 2;
 SPEAKER_ITEMS = 3;
 SPEAKER_IO_ADDR42 = $42 ;
 SPEAKER_IO_ADDR43 = $43 ;
 SPEAKER_IO_ADDR61 = $61 ;

type
  SPEAKER_STRUCT = record
    hWD: HANDLE;
    cardReg: WD_CARD_REGISTER;
  end;
  SPEAKER_HANDLE = ^SPEAKER_STRUCT;

  function SPEAKER_Open(var hSPEAKER: SPEAKER_HANDLE ): boolean;
  procedure SPEAKER_Close(hSPEAKER: SPEAKER_HANDLE);
  procedure SPEAKER_Tone(hSPEAKER: SPEAKER_HANDLE; dwHz: DWORD ; dwMilli: DWORD);

var
  SPEAKER_ErrorString: string[255];

implementation

{ internal function for the SPEAKER_Open function }
procedure SPEAKER_SetCardElements(hSPEAKER: SPEAKER_HANDLE);
type
  WD_ITEMS_A = array [0..SPEAKER_ITEMS] of WD_ITEMS;
var
  pItem: ^WD_ITEMS_A;
begin
    hSPEAKER^.cardReg.Card.dwItems:= SPEAKER_ITEMS;
    pItem := @hSPEAKER.cardReg.Card.Item;
    { SPEAKER IO range }
    pItem^[SPEAKER_IO_42].item:= ITEM_IO;
    pItem^[SPEAKER_IO_42].fNotSharable:= Integer(FALSE);
    pItem^[SPEAKER_IO_42].IO.dwAddr:= SPEAKER_IO_ADDR42;
    pItem^[SPEAKER_IO_42].IO.dwBytes:= 1;
    pItem^[SPEAKER_IO_43].item:= ITEM_IO;
    pItem^[SPEAKER_IO_43].fNotSharable:= Integer(FALSE);
    pItem^[SPEAKER_IO_43].IO.dwAddr:= SPEAKER_IO_ADDR43;
    pItem^[SPEAKER_IO_43].IO.dwBytes:= 1;
    pItem^[SPEAKER_IO_61].item:= ITEM_IO;
    pItem^[SPEAKER_IO_61].fNotSharable:= Integer(FALSE);
    pItem^[SPEAKER_IO_61].IO.dwAddr:= SPEAKER_IO_ADDR61;
    pItem^[SPEAKER_IO_61].IO.dwBytes:= 1;
end;

function SPEAKER_Open (var hSPEAKER: SPEAKER_HANDLE ): boolean;
  label exit,finish;
var
  ver: SWD_VERSION;
begin
  GetMem(hSPEAKER,sizeof(SPEAKER_STRUCT));
  hSPEAKER^.cardReg.hCard:= 0;
  FillChar(hSPEAKER^, sizeof(hSPEAKER^), 0);

  hSPEAKER^.hWD := INVALID_HANDLE_VALUE;
  hSPEAKER^.hWD := WD_Open();
  if hSPEAKER^.hWD=INVALID_HANDLE_VALUE then
  begin
    SPEAKER_ErrorString:= 'Cannot open WinDriver device';
    goto exit;
  end;
  { cheak if using the current version }
  FillChar(ver, sizeof(ver), 0);
  WD_Version(hSPEAKER^.hWD,ver);
  if ver.dwVer<WD_VER then
  begin
    SPEAKER_ErrorString:= 'error - incorrect WinDriver version';
    goto exit;
  end;

  SPEAKER_SetCardElements(hSPEAKER);
  hSPEAKER^.cardReg.fCheckLockOnly:= DWORD (FALSE);
  WD_CardRegister(hSpeaker^.hWD, hSpeaker^.cardReg);
  if (hSPEAKER^.cardReg.hCard=0) then
  begin
    SPEAKER_ErrorString:= 'error - could not lock device';
    goto exit;
  end;

  {open finished OK}
  SPEAKER_Open:= TRUE;
  goto finish;

exit:
  {error during open}
  if (hSPEAKER^.cardReg.hCARD<>0) then
    WD_CardUnregister(hSPEAKER^.hWD, hSPEAKER^.cardReg);
  if (hSPEAKER^.hWD<>INVALID_HANDLE_VALUE) then
    WD_Close(hSPEAKER^.hWD);
  FreeMem(hSPEAKER,sizeof(SPEAKER_STRUCT));
  SPEAKER_Open:= FALSE;

finish:

end;

procedure SPEAKER_Close (hSPEAKER: SPEAKER_HANDLE);
begin
  { unregister card }
  if (hSPEAKER^.cardReg.hCard<>0) then
    WD_CardUnregister(hSPEAKER^.hWD, hSPEAKER^.cardReg);

  { close WinDriver }
  WD_Close(hSPEAKER^.hWD);

  FreeMem(hSPEAKER,sizeof(SPEAKER_STRUCT));
end;

procedure SPEAKER_WriteCtrl (hSPEAKER: SPEAKER_HANDLE; data: BYTE );
var
  trans: SWD_TRANSFER;
begin
  FillChar(trans, sizeof(trans), 0);
  trans.cmdTrans:= WP_BYTE;
  trans.dwPort:= SPEAKER_IO_ADDR61;
  trans.AByte:= data;
  WD_Transfer(hSPEAKER^.hWD, trans);
end;

function SPEAKER_ReadCtrl (hSPEAKER: SPEAKER_HANDLE): BYTE;
var
  trans: SWD_TRANSFER;
begin
  FillChar(trans, sizeof(trans), 0);
  trans.cmdTrans:= RP_BYTE;
  trans.dwPort:= SPEAKER_IO_ADDR61;
  WD_Transfer(hSPEAKER^.hWD, trans);
  SPEAKER_ReadCtrl:= trans.AByte;
end;

procedure SPEAKER_WriteTimerData (hSPEAKER: SPEAKER_HANDLE; data: BYTE);
var
  trans: SWD_TRANSFER;
begin
  FillChar(trans, sizeof(trans), 0);
  trans.cmdTrans:= WP_BYTE;
  trans.dwPort:= SPEAKER_IO_ADDR42;
  trans.AByte:= data;
  WD_Transfer(hSPEAKER^.hWD, trans);
end;

procedure SPEAKER_WriteTimerCtrl (hSPEAKER: SPEAKER_HANDLE; data: BYTE);
var
  trans: SWD_TRANSFER;
begin
  FillChar(trans, sizeof(trans), 0);
  trans.cmdTrans:= WP_BYTE;
  trans.dwPort:= SPEAKER_IO_ADDR43;
  trans.AByte:= data;
  WD_Transfer(hSPEAKER^.hWD, trans);
end;

procedure SPEAKER_Tone (hSPEAKER: SPEAKER_HANDLE; dwHz: DWORD; dwMilli: DWORD);
var
  dwDevisor: DWORD;
  bCtrl: BYTE ;
begin
  dwDevisor:= 1190000 div dwHz;

  SPEAKER_WriteTimerCtrl(hSPEAKER, $b6);
  SPEAKER_WriteTimerData(hSPEAKER, BYTE (dwDevisor and $ff));
  SPEAKER_WriteTimerData(hSPEAKER, BYTE((dwDevisor shr 8) and $ff));

  bCtrl:= SPEAKER_ReadCtrl(hSPEAKER);
  SPEAKER_WriteCtrl(hSPEAKER, BYTE (bCtrl or (BIT0 or BIT1)));
  Sleep(dwMilli);
  SPEAKER_WriteCtrl(hSPEAKER, BYTE (bCtrl and not(BIT0 or BIT1)));
end;

end.